perm filename FILL.FAI[NEW,LCS] blob
sn#163344 filedate 1975-06-11 generic text, type T, neo UTF8
00100 TITLE FILL
00200 ENTRY FILLER,LINES
00300 DEFINE FLOAT(N)
00400 < TLC N,232000
00500 FADR N,N >
00600 DEFINE FIXX(N)
00700 < JUMPGE N,.+5
00800 MOVNS N
00900 FIX N,233000
01000 MOVNS N
01100 CAIA
01200 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01300
01400 KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01500 RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01600 HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01700
01800 ; SUBROUTINE FILLER(Q,M)
01900 FILLER: 0
02000 MOVEM 16,SV16#
02100 HRRZ J,(16)
02200 HRRZM J,SVQ#
02300 HRRZ T,@1(16)
02400 HRRZM T,SVM# ; KK=NE(1)
02500 HRRZ KK,2(J)
02600 ADDI KK,-1(J)
02700 ; DO 4 K=2,KK
02800 HRRZI L,2(J)
02900 ; IF(NE(K).NE.3)GO TO 11
03000 L4: ADDI L,3
03100 HRRZ T,(L)
03200 L11: SETZM (L)
03300 CAIN T,3
03400 ; NE(K)=-1
03500 SETOM (L)
03600 ; GO TO 4
03700 ; 11 NE(K)=0
03800 ; 4 CONTINUE
03900 CAIGE L,(KK)
04000 JRST L4
04100 ; RLFT=10000
04200 MOVE RL,[=10000.0]
04300 ; RT=-10000
04400 MOVN RJ,[=10000.0]
04500 ; B=RT
04600 MOVE B,RJ
04700 ; DO 12 K=1,KK
04800 HRRZI L,-3(J)
04900 ; H=IFIX(Q(K))
05000 L12: ADDI L,3
05100 MOVE H,(L)
05200 FIXX(H)
05300 FLOAT(H)
05400 ; IF(H.LT.RLFT)RLFT=H
05500 CAMGE H,RL
05600 MOVE RL,H
05700
05800 ; IF(H.GT.RT)RT=H
05900 CAMLE H,RJ
06000 MOVE RJ,H
06100 ; IF(H.EQ.B)NE(K)=-1
06200 CAMN H,B
06300 SETOM 2(L)
06400 ; B=H
06500 MOVE B,H
06600 ; Q(K)=H
06700 MOVEM H,(L)
06800 ; 12 R(K)=IFIX(R(K))
06900 MOVE T,1(L)
07000 FIXX(T)
07100 FLOAT(T)
07200 MOVEM T,1(L)
07300 CAIGE L,-2(KK)
07400 JRST L12
07500 ; NE(KK+1)=-1
07600 SETOM 3(KK)
07700
07800 ; LRT=RT
07900 FIXX(RJ)
08000 MOVEM RJ,LRT#
08100 ; JA=3
08200 HRRZI T,3
08300 HRRZM T,JA#
08400
08500
08600 ; 124 LEFT=RLFT
08700 L124: MOVE LE,RL
08800 FIXX(LE)
08900 ; 51 J=LEFT
09000 L51: MOVE J,LE
09100 ; 42 RJ=J+.001
09200 L42: MOVE RJ,J
09300 FLOAT(RJ)
09400 FADR RJ,[=0.001]
09500 ; JCONT=0
09600 SETZM JCONT#
09700 ; LEFT=J
09800 MOVE LE,J
09900
10000 ; JJ=-1
10100 SETO JJ,
10200 ; ALT=-10000.
10300 MOVN AL,[=10000.0]
10400 ; 200 DO 45 L=2,KK
10500 HRRZ L,SVQ
10600 L45: ADDI L,3
10700 CAILE L,-2(KK)
10800 JRST L455
10900 ; IF(NE(L).NE.0)GO TO 45
11000 SKIPE 2(L)
11100 JRST L45
11200 ; IF(MISS(L,RJ,Q))GO TO 45
11300 CAML RJ,-3(L)
11400 JRST L201
11500 CAMLE RJ,(L)
11600 JRST L202
11700 L201: CAMGE RJ,(L)
11800 CAMG RJ,-3(L)
11900 JRST L45
12000 ; H=HGHT(L,RJ,Q,R)
12100 L202: MOVE H,-2(L)
12200 CAMN H,1(L)
12300 JRST RET
12400 MOVNS H
12500 FADR H,1(L)
12600 MOVE D,-3(L)
12700 MOVNS T,D
12800 FADR T,RJ
12900 FADR D,(L)
13000 FMPR H,T
13100 FDVR H,D
13200 FADR H,-2(L)
13300 ; IF(H.LT.ALT)GO TO 45
13400 RET: CAMGE H,AL
13500 JRST L45
13600
13700 ; ALT=H
13800 MOVE AL,H
13900 ; JJ=L
14000 HRRZI JJ,(L)
14100 ; 45 CONTINUE
14200 JRST L45
14300 ; IF(JJ)GO TO 43
14400 L455: JUMPL JJ,L43
14500 ; JCONT=-1
14600 SETOM JCONT
14700 ; LEFT=J
14800 MOVE LE,J
14900 ; 46 JA=3
15000 L46: HRRZI T,3
15100 HRRZM T,JA
15200 ; JORD=-1
15300 SETOM JORD#
15400 ; 52 KN=Q(JJ)
15500 L52: MOVE T,(JJ)
15600 FIXX(T)
15700 MOVEM T,KN#
15800 ; KL=Q(JJ-1)
15900 MOVE T,-3(JJ)
16000 FIXX(T)
16100
16200 MOVEM T,KL#
16300 ; IF(KN.LT.KL)KN=KL
16400 CAMLE T,KN
16500 MOVEM T,KN
16600 ; 50 I=J
16700 L50: MOVEM J,I#
16800 ; 102 RJ=I+.01
16900 L102: MOVE RJ,I
17000 FLOAT(RJ)
17110 FADR RJ,[=0.1] ;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
17200 ; ALT=HGHT(JJ,RJ,Q,R)
17300 MOVE AL,-2(JJ)
17400 CAMN AL,1(JJ)
17500 JRST RET2
17600 MOVNS AL
17700 FADR AL,1(JJ)
17800 MOVE D,-3(JJ)
17900 MOVNS T,D
18000 FADR T,RJ
18100 FADR D,(JJ)
18200 FMPR AL,T
18300 FDVR AL,D
18400 FADR AL,-2(JJ)
18500 ; B=-10000
18600 RET2: MOVN B,[=10000.0]
18700 ; JK=-1
18800 SETO JK,
18900 ; XALT=ALT+.001
19000 MOVE T,AL
19100 FADR T,[=0.001]
19200 MOVEM T,XALT#
19300
19400 ; ZALT=ALT
19500 MOVEM AL,ZALT#
19600 ; 400 DO 47 L=2,KK
19700 MOVE L,SVQ
19800 L47: ADDI L,3
19900 CAILE L,-2(KK)
20000 JRST L477
20100 ; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20200 CAME L,JJ
20300 SKIPGE 2(L)
20400 JRST L47
20500 CAML RJ,-3(L)
20600 JRST L475
20700 CAMLE RJ,(L)
20800 JRST L476
20900 L475: CAMGE RJ,(L)
21000 CAMG RJ,-3(L)
21100 JRST L47
21200 ; H=HGHT(L,RJ,Q,R)
21300 L476: MOVE H,-2(L)
21400 CAMN H,1(L)
21500 JRST RET3
21600 MOVNS H
21700 FADR H,1(L)
21800 MOVE D,-3(L)
21900 MOVNS T,D
22000 FADR T,RJ
22100 FADR D,(L)
22200 FMPR H,T
22300 FDVR H,D
22400 FADR H,-2(L)
22500 ; IF(H.GT.XALT)GO TO 47
22600 RET3: CAMG H,XALT
22700
22800 ; IF(H.LE.B)GO TO 47
22900 CAMG H,B
23000 JRST L47
23100 ; B=H
23200 MOVE B,H
23300 ; JK=L
23400 HRRZI JK,(L)
23500 ; 47 CONTINUE
23600 JRST L47
23700 ; IF(JK)GO TO 48
23800 L477: JUMPL JK,L48
23900 ; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24000 MOVN T,B
24100 FADR T,ZALT
24200 CAMG T,[=0.001]
24300 CAME J,I
24400 JRST L59
24500 ; JX=Q(JK)
24600 MOVE T,(JK)
24700 FIXX(T)
24800 ; IF(JX.GT.KN)GO TO 60
24900 CAMLE T,KN
25000 JRST L60
25100 ; JX=Q(JK-1)
25200 MOVE T,-3(JK)
25300 FIXX(T)
25400 ; IF(JX.LT.KN)GO TO 59
25500 CAMGE T,KN
25600 JRST L59
25700 ; 60 L=JJ
25800 L60: MOVE L,JJ
25900 ; JJ=JK
26000 MOVE JJ,JK
26100 ; JK=L
26200 MOVE JK,L
26300 ; KN=JX
26400 MOVEM T,KN
26500
26600 ; 59 IF(ALT-B.LT.2)GO TO 62
26700 L59: MOVN T,B
26800 FADR T,AL
26900 CAMGE T,[=2.0]
27000 JRST L62
27100 ; ALT=ALT-1
27200 HRLZI T,576400
27300 FADR AL,T
27400 ; B=B+1
27500 HRLZI T,201400
27600 FADR B,T
27700 ; 62 IF(JORD)GO TO 103
27800 L62: SKIPGE JORD
27900 JRST L103
28000 ; H=B
28100 MOVE H,B
28200 ; B=ALT
28300 MOVE B,AL
28400 ; ALT=H
28500 MOVE AL,H
28600 ; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28700
28800 CAMN JK,NK#
28900 JRST L103
29000 MOVN T,B
29100 FADR T,AL
29200 SKIPGE T
29300 MOVNS T
29400 CAMG T,[5.0]
29500 JRST L103
29600 HRRZI T,3
29700 HRRZM T,JA
29800 ; 103 CALL LINES(RJ,ALT,JA)
29900 L103: MOVEM RJ,SVRJ#
30000 MOVEM AL,SVAL#
30100 MOVEM B,SVB#
30200 HRRZI 16,SVAC
30300 BLT 16,SVAC+15
30400 JSA 16,LINES
30500 JUMP SVRJ
30600 JUMP SVAL
30700 JUMP JA
30800 ; 100 CALL LINES(RJ,B,2)
30900 JSA 16,LINES
31000 JUMP SVRJ
31100 JUMP SVB
31200 JUMP [2]
31300 HRLZI 16,SVAC
31400 BLT 16,15
31500 ; NK=JK
31600 MOVEM JK,NK
31700
31800 ; JORD=-JORD
31900 MOVNS JORD
32000 ; NE(JK)=1
32100 HRRZI T,1
32200 HRRZM T,2(JK)
32300 ; NE(JJ)=-1
32400 SETOM 2(JJ)
32500 ; JA=2
32600 HRRZI T,2
32700 HRRZM T,JA
32800 ; I=I+M
32900 MOVE T,SVM
33000 ADDB T,I
33100 ; IF(I.LT.KN)GO TO 102
33200 CAMGE T,KN
33300 JRST L102
33400 ; L=1
33500 HRRZI L,3
33600 ; IF(KN.EQ.KL)L=-1
33700 MOVE T,KN
33800 CAMN T,KL
33900 HRROI L,-3
34000 ; JJ=JJ+L
34100 ADD JJ,L
34200 ; J=0
34300 SETZ J,
34400 ; IF(L)J=-1
34500 SKIPGE L
34600 HRROI J,-3
34700 ; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
34800 SKIPN 2(JJ)
34900 CAILE JJ,-2(KK)
35000 JRST L124
35100 ADD T,SVM
35200 FLOAT(T)
35300 HRRZI HG,(JJ)
35400 ADD HG,J
35500 CAMLE T,(HG)
35600 JRST L124
35700 ; J=I
35800 MOVE J,I
35900 ; GO TO 52
36000 JRST L52
36100 ; 48 JA=3
36200 L48: HRRZI T,3
36300 HRRZM T,JA
36400 ; 43 J=LEFT+M
36500 L43: MOVE J,LE
36600 ADD J,SVM
36700 ; IF(J.LE.LRT)GO TO 42
36800 CAMG J,LRT
36900 JRST L42
37000 ; IF(JCONT)GO TO 51
37100 SKIPGE JCONT
37200 JRST L51 ; END
37300 MOVE 16,SV16
37400 JRA 16,2(16)
37500 SVAC: BLOCK 16
37600
37700
37800 EXTERNAL DST,SIZ,PLTR,DPY,AIVECT,AVECT,.COMM.
37900 ; SUBROUTINE LINES(A,B,L)
38000 ; COMMON/DST/BB,CC
38100 ; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38200 ; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38300 ; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38400 ; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38500 ; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38600 ; 1,(JJ2,JJ(2))
38700 ; DATA BB/.008/,CC/3.5/
38800 ;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38900
39000 M←2 ↔ N←3 ↔ K←4
39100
39200 LINES: 0
39300 ; GO TO 23
39400 JRST L23
39500 ;22 IF(JQ(1).NE.0)GO TO 23
39600 L22: SKIPE PLTR+=27
39700 JRST L23
39800 ; IF(CC.EQ.1000)GO TO 23
39900 MOVSI T,212764
40000 CAMN T,DST+1
40100 JRST L23
40200 ; B=B*(CC-BB*ABS(A))
40300 MOVE T,@(16)
40400 MOVM T,T
40500 FMPR T,DST
40600 FSBR T,DST+1
40700 FMPRM T,@1(16)
40800 MOVNS @1(16)
40900 ;23 IF(IPLT)GO TO 2
41000 ; M=A*RSZ
41100 L23: MOVE M,@(16)
41200 FMPR M,SIZ
41300 FIXX(M)
41400 ; N=B*RSZ
41500 MOVE N,@1(16)
41600 FMPR N,SIZ
41700 FIXX(N)
41800 ; IF(RSZ.LE.0.8571)GO TO 3
41900 MOVE T,[=0.8571]
42000 CAML T,SIZ
42100 ;; JRST L3
42200 JRST L6
42300
42400 SUB M,SIZ+1 ; M=M-JCEN
42500 SUB N,SIZ+2 ; N=N-KCEN
42600 ; IF(JA.NE.8)GO TO 5
42700 MOVEI T,10
42800 CAME T,.COMM.+1
42900 JRST L5
43000 ; IF(M.GT.511)M=511
43100 CAMLE M,[=511]
43200 HRRZI M,=511
43300 ; IF(M.LT.-511)M=-511
43400 CAMGE M,[-=511]
43500 HRROI M,-=511
43600 ;5 IF(IABS(M).GT.512)GO TO 77
43700 L5: CAIG M,=512
43800 CAMGE M,[-=512]
43900 JRST L77
44000 ; IF(IABS(N).LT.512)GO TO 4
44100 CAIGE N,=512
44200 CAMG N,[-=512]
44300 CAIA
44400 JRST LL4
44500 ;77 KZ=-1
44600 L77: SETOM KZ#
44700 ; RETURN
44800 JRA 16,3(16)
44900 ;4 IF(KZ.EQ.0)GO TO 6
45000 LL4: SKIPN KZ
45100 JRST L6
45200 ; KZ=0
45300 SETZM KZ
45400 MOVEM M,MM# ; GO TO 1
45500 MOVEM N,NN#
45600 JRST L1
45700 ;3 IF(JA.EQ.44)GO TO 6
45800 ;6 IF(JJ2.GT.3990)RETURN
45900 L6: MOVEI T,7626
46000 CAMGE T,DPY+1
46100 JRA 16,3(16)
46200 ; IF(L.EQ.3)GO TO 1
46300 MOVEM M,MM
46400 MOVEM N,NN
46500 HRRZI T,3
46600 CAMN T,@2(16)
46700 JRST L1
46800 ; CALL AVECT(M,N)
46900 JSA 16,AVECT
47000 JUMP MM
47100 JUMP NN
47200 ; RETURN
47300 JRA 16,3(16)
47400 ;1 CALL AIVECT(M,N)
47500 L1: JSA 16,AIVECT
47600 JUMP MM
47700 JUMP NN
47800 ; RETURN
47900 JRA 16,3(16)
48000 ;2 IF(IPLT.EQ.-2)RETURN
48100 ;;L2: MOVNI T,2
48200 ;; CAMN T,PLTR
48300 ;; JRA 16,3(16)
48400 END